00100	C**** BMSTF, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00300		SUBROUTINE BMSTF
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700		1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800	C  RDBR IS SPACER FOR DBL BAR.
01900	C  RTF COMPENSATES FOR BAD PLANNING.
02000		RST7=RSTJ2*7.
02100		RST18=RSTJ2*18.
02200	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300	
02400		R3Q=R3
02700		IF(JA.EQ.8)GO TO 100
02800	C  GO TO STAVES.
37900	
38200	C  NEXT IS FOR BEAMS
38300		RMINI=RSTJ2
38400		RX=2.7*RSTJ2*5.96
38500	C******************************
38600		R6=RHORZ(R6)
38700		IF(R8.NE.0)GO TO 204
38800		IF(R10.GE.10)GO TO 204
38900		IF(J7)GO TO 204
39000		IF(R9.NE.0)GO TO 1
39100	C  R8=0 AND R9=NUM  -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLETS, ETC.)
39200	204	IF(R9.NE.0)R9=RHORZ(R9)
39300		IF(J7)GO TO 201
39400	200	IF(J10.LT.10)GO TO 91
39500	C NEXT FOR INNER, PARTIAL BEAMS
39600		R8=RHORZ(R8)
39700		R10=AMOD(R10,10.)
39800		GO TO(2,3,4),J10/10
39900	2	RH=R9+RX
40000		GO TO 1
40100	3	R8=R9-RX
40200	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
40300	4	RH=R8
40400	C  LEFT INNER POS.
40500		GO TO 1
40600	201	J7=-J7
40700	C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=DISP.
40800		CALL NOZERO(R10)
40900	C  ALWAYS AT LEAST 1 IN DISPLACEMENT
41000		J10=30
41100	C TO ACTIVATE PARTIAL BEAM SECTION
41200		IF(J9.NE.0)GO TO 202
41300	C  NEXT FOR TREM. WITHOUT OTHER BEAMS.
41400		RH=-1
41500		IF(J7.GE.20)RH=-RH
41600	CC203	R4=R4+R10*RH
41700	CC	CALL CENTX
41800		R5=R4+RH
41900		R9=R3
42000		R6=R3+22.*RMINI
42100	202	IF(R8.EQ.0)R8=4. 
42200		RX=R8*RMINI*2.98
42300		RH=R9+RX
42400		R9=R9-RX
42500		GO TO 1
42600	
42700	91	IF(J8.EQ.0)GO TO 1
42800		IF(J8.GT.0)GO TO 92
42900	C FOR J8=-(10+DN) OR -(20+DN)
43000		R9=R3+RX
43100		IF(J8.LE.-20)R9=R6-RX
43200	192	J8=-J8
43300	92	IF(J10.EQ.0)J10=MOD(J8,10)
43400	CC??? 4/75	J8=J8-J10
43500		IF(J10.EQ.0)J10=1
43600		R10=J10
43700	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
43800	1	IF(IABS(J4).LT.100)GO TO 97
43900		RMINI=.6*RSTJ2
44000		R5=AMOD(R5,100.0)
44100	C   SPACE BETWEEN BEAMS
44200	97	RJ=RMINI*11.
44300		RW=RMINI*RHGT
44400	C  DIST. UP OR DOWN FROM NOTE HEAD.
44500		RJA=R10*RJ
44600	C  DISPLACEMENT
44700		RD=R9
44800	C  POSITION 3
44900		RJX=CENTR-RW+RJA
45000	C  FINAL HEIGHT OF LEFT SIDE
45100	C  NEG R7=TREMOLO
45200		RX=MOD(J7,10)
45300		JJ2=J7-20
45400		RA=R6
45500	C  HORIZANTAL DIST.
45600		RJY=R5*RST7+POS-RST18-RW+RJA
45700	C   VERTICAL POS OF RIGHT SIDE.
45800		RW=R14*RMINI
45900		RY=1.
46000		IF(J7.GE.20)GO TO 98 
46100	C JUMP IF STEMS ARE DOWN
46200		RY=-RY
46300	C  FOR  THICKENING INCR.
46400		JJ2=J7-10
46500		RJ=-RJ
46600		RJA=RMINI*R2HGT-2.*RJA
46700		RJX=RJX+RJA
46800		RJY=RJY+RJA
46900		R3Q=R3Q+RW
47000	C  POSITION 1
47100		RA=RA+RW
47200	C  POSITION 2
47300		RD=RD+RW
47400	C******************************
47500		RH=RH+RW
47600	98	RSTJ2=RSTJ2*RBM
47700	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
47800	93	IF(JJ2.GT.RX)GO TO 94
47900		IF(J10.GE.10)GO TO 7
48000	C**********************
48100		IF(J8.EQ.0)GO TO 94
48200		R3=RW
48300		IF(J9.EQ.0)GO TO 292
48400	 	IF(J8.GE.20)GO TO 193
48500	293	RX=R3Q-RD
48600		GO TO 194
48700	7	RHX=RH-R3Q
48800		R3=RD-R3Q
48900		GO TO 292
49000	193	RX=RD-RA
49100	194	R3=ABS(RX)
49200	292	DISX=ABS(R3Q-RA)
49300		HGT=RJX-RJY
49400		IF(J10.GE.10)HGT1=HGT*RHX/DISX
49500	C**********************
49600		R3=R3/DISX
49700	195	HGT=HGT*R3
49800	196	L=J8/10
49900		J8=0
50000		IF(J10.GE.10)GO TO 8
50100	C***************
50200		IF(L.EQ.1)GO TO 95
50300	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
50400		R3Q=RD
50500		RJX=RJY+HGT
50600		GO TO 94
50700	C**************
50800	8	R3Q=RH
50900		RA=RD
51000		RJY=RJX-HGT
51100		RJX=RJX-HGT1
51200		GO TO 94
51300	95	RA=RD
51400		RJY=RJX-HGT
51500	94	L=7.*RMINI
51600	930	RC=0
51700	C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??
51800		CALL LINES(R3Q,RJX,3)
51900		DO 941 K=1,L
52000		CALL BMS
52100		IF(PLT.GE.0)GO TO 940
52200		RC=RC+RY
52300	C FOR THICKENING.
52400		CALL BMS
52500		CALL EXCH(RA,R3Q)
52600	941	CALL EXCH(RJY,RJX)
52700		CALL BMS
52800	C  DRAWS 5 LINES FOR BEAMS.
52900	940	JJ2=JJ2-1
53000		IF(JJ2.LE.0)GO TO 942
53100	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
53200		RJY=RJY+RJ
53300		RJX=RJX+RJ
53400		GO TO 930
53500	
53600	942	IF(R8.NE.0)RETURN
53700		IF(R9.EQ.0)RETURN
53800		IF(R10.GE.30)RETURN
53900	C FOR NUMBERS OUTSIDE BEAMS
54000		RSTJ2=RMINI
54100		RD=-10.
54200		IF(R7.LT.20)RD=8.3
54300	943	J3=R3Q+(RA-R3Q)/2.
54400		R6=1.
54500	CC *** DONE IN CENTX ***	R4=AMOD(R4,100.)
54600		R4=R4+(R5-R4)/2.+RD
54700		R7=1
54800	C ITALICS
54900		CALL MAKNUM(R9)
55000		RETURN
55100	
55200	100	RA=0
55300	C  FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S), 
55400	C  P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
55500	C  P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS. 
55600	C  PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
55700		IF(R5.EQ.0)R5=RSTFAC(J2)
55800		CALL NOZERO(R5)
55900		RSTFAC(J2)=R5
56000		RX=(J2+3)*123-369.+R4*7.*R5
56100	CC	RC=R5
56200		STFF(J2)=RX
56300		RX=RX+RTF*R5
56400	C  FOR RTF SEE DATA
56500		RA=RX
56600	C  FOR 2 PASS PLOTTING
56700		RJ=RHORZ(R6)
56800		IF(R6.EQ.0)RJ=596
56900		R5=R5*14.
57000		IF(R8.EQ.0)GO TO 68
57100		IF(PLT)GO TO 68
57200		RZ=RX+R8*167.
57300	C  167 IS A MAGIC NUMBER!!  PUTS LINE ON DPY.
57400		CALL LINX(R3,RZ,RJ,RZ)
57500	C  SHOWS WHERE NEXT STAFF 0 WILL BE.
57600	68	IF(J7.EQ.0)GO TO 101
57700		IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
57800	C  TO ACTIVATE DPY BUFFER
57900		RETURN
58000	101	DO 6 K=1,5
58100		RZ=RJ
58200		RW=R3
58300		IF(K.EQ.2)GO TO 66
58400		IF(K.NE.4)GO TO 67
58500	66	CALL EXCH(RW,RZ)
58600	67	CALL LINX(RZ,RX,RW,RX)
58700	6	RX=RX+R5
58800		IF(RA.EQ.1000)RETURN
58900		IF(PLT.NE.-2)RETURN
59000		RX=RA-1./RHT
59100	CC	R5=RC
59200		RA=1000
59300		GO TO 101
59400		END
59500	
59600	CC	SUBROUTINE BMS
59700	CC	COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RJY
59800	CC	CALL LINES(RA,RJY+RC*RSTJ2,2)
59900	CC	END
60000	
60100		SUBROUTINE METER
60200	      COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
60300		COMMON/POSI/STFF(-3/4),JJ2,POS
60400		EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
60500		1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
60600	
60700	C  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
60800	
60900		CALL NOZERO(R7)
61000		JZ=J3
61100		RY=R4+8.*R7
61200	C  HEIGHT
61300		RW=R6
61400	C  BOTTOM NUM
61500	C  P5=TOP NUM
61600		R6=R7
61700		RR6=R6
61800	C  SIZE
61900	C  FOR BDR40  -- OR =1
62000		M=0
62100		R4=RY
62200	2	R7=0
62300	C  R7=0 FOR BDR FONT??
62400	CC	IF(R5.NE.99)GO TO 1
62500		IF(R5.LT.90)GO TO 3
62600	C  99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
62700		M=-1
62800		IF(R5.NE.98)GO TO 4
62900	C NEXT FOR LINE THROUGH C.
63000		RZ=R6
63100		RY=R4
63200		RA=POS
63300		R6=RX3
63400	C  TO LINE UP WITH R3
63500		J10=2
63600	C  FOR THICK LINE
63700		R4=4.2
63800		R5=9.8
63900		J7=0
64000		R8=0
64100		CALL ITMSUB
64200		POS=RA
64300		R4=RY
64400		R6=RZ
64500	C GET BACK THE RIGHT PARAMS.
64600	
64700	4	R5=9999.
64800		GO TO 3
64900	C  TO CENTER 12S AND 16S
65000	3	CALL MAKNUM(R5)
65100		IF(M)RETURN
65200	C  STICK AROUND FOR BOTTOM NUM
65300		M=-1
65400		R4=RY-4.*RR6
65500		R6=RR6
65600		R5=RW
65700	C  GET BOTTOM NUM
65800		J3=JZ
65900		R8=0
66000		GO TO 2
66100		END
66200	
66300	CF	SUBROUTINE RNOTE(X)
66400	CF	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
66500	CF	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
66600	CF	END
66700	
66800		SUBROUTINE MAKNUM(RNUM)
66900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
67000		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
67100	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
67200		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
67300		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
67400		DATA RS/10.0/,RBX/1.0/
67500		RB8=R8
67600		J3X=J3
67700	C P7=0=BDR40; =1=BDI40; =2=PRIM.
67800		CALL NOZERO(R6)
67900		R5=R6
68000	C  UPPER CASE - BDR40
68100		R6=48000000.0+(R7+50.)*10000.
68200		R7=99999999.0
68300	C  BLANKS
68400		R8=R7
68500		IF(RNUM.NE.9999.)GO TO 2
68600	C  NEXT FOR 'C'OMMON TIME
68700		RNUM=12.
68800	C  MAKES A 'C'
68900		R4=R4-2.2
69000	C  .2 FOR BAD POS. OF LETTERS
69100		GO TO 4
69200	
69300	2	ONE=0 
69400		RNUM=IFIX(RNUM)
69500	C  SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
69600		IF(RNUM.EQ.1.)ONE=3.
69700		IF(RNUM.GT.9.)GO TO 3
69800	C  JUMP FOR 2 OR 3 DIGIT NUMBER
69900	4	R6=R6+RNUM*100.+47.
70000	C  PUTS BLANK ON END (.47)
70100		GO TO 1
70200	
70300	3	RJY=10.
70400		IF(RNUM.GE.100.)RJY=100.
70500		B=IFIX(RNUM/RJY)
70600		C=AMOD(RNUM,RJY)
70700		IF(RNUM.LT.100)GO TO 7
70800		D=IFIX(C/10.)
70900		C=AMOD(C,10.)
71000		IF(C.EQ.1.)ONE=ONE+3.
71100		R7=C*1000000.+999999.0
71200		C=D
71300	7	R6=R6+B*100.+C
71400		IF(B.EQ.1.)ONE=ONE+3.
71500		IF(C.EQ.1.)ONE=ONE+3.
71600		B=R5
71700		IF(RNUM.GE.100.)B=B*2
71800		J3=J3-RS*RSTJ2*B
71900	C  FOR 2 DIGIT NUMBER
72000	CCC	IF(RNUM.GE.20.)GO TO 6
72100	CCC	IF(JA.EQ.18)GO TO 6
72200	CCC	RJY=5.6
72300	CCC	IF(RNUM.GT.11.)RJY=3.
72400	C  ADJUSTS FOR 11, ETC.
72500	CCC	J2=J2+RJY*R5*RSTJ2
72600	CC6	J3=J2
72700	1	J3=J3+ONE*R5*RSTJ2
72800	C CENTERS THE NUMBER '1'
72900		CALL ALPHA
73000		J3=J3X
73100		IF(RB8.EQ.0)RETURN
73200	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
73300		R3=J3-R5
73400		IF(J10.EQ.0)J10=1
73500	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
73600		IF(RNUM.GT.9)R3=R3+R5*RBX
73700	C  TO SET CENTER
73800		IF(RB8.EQ.2)GO TO 5
73900		R4=R4+R5+.1+.05/R5
74000	C  END OF ABOVE IS FOR SMALL CIRCLES.
74100		B=4.5
74200		IF(RNUM.GE.100.)B=5.5
74300		R5=R5*B
74400		JA=12
74500		J6=0
74600		J7=0
74700		J8=J10
74800		CALL CENTX
74900		CALL SLUR
75000		RETURN
75100	
75200	5	JA=4
75300		B=6
75400		R9=0
75500		IF(RNUM.LT.100.)GO TO 8
75600		B=9.
75700		R9=R5*6.
75800	C  MAKES RECTANGLE IF ≥100
75900	8	R4=R4+R5*.7+.1
76000		R8=R5*B
76100		J5=50
76200		CALL ITMSUB
76300	C  RETURNS ORIG. HORIZ. POS.
76400		END
76500	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
76600	
76700	CC	FUNCTION IABS(N)
76800	C  BECAUSE IABS IN LIB40 HAS A BUG.
76900	CC	IABS=N
77000	CC	IF(N)IABS=-N
77100	CC	END
77200	
77300	CF	SUBROUTINE DRWNT(RMINI)
77400	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
77500	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
77600	CF	EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
77700	CF	1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
77800	CF	1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
77900	CF	RJX=CENTR
78000	CF	JH=0
78100	C  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
78200	CC	CENTR=CENTR-21.*RSTJ2
78300	CF	RA=R6
78400	CF	R6=.5*RMINI/RSTJ2
78500	CF	R7=R6
78600	CF	RJD=RJZ-3
78700	CCXX	IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
78800	C  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
78900	CF	JI=0
79000	CF	CALL CLEFS
79100	CF	JI=R9
79200	C  ↑↑↑↑↑↑ NEEDED??
79300	C  FIX THIS???? ↑↑↑↑↑
79400	C  FOR WHITE NOTES AND ACCIS ON PLOTTER.
79500	CF	CENTR=RJX
79600	CF	R6=RA
79700	CF	R7=JG
79800	CF	JE=RJE
79900	CF	END
80000	
80100	CC	FUNCTION RHORZ(R)
80200	CC	RHORZ=R*5.96-596.
80300	CC	END
80400	
80500	CF	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
80600	C   TO X,Y INTO ONE WORD
80700	CF	DIMENSION XY(1)
80800	CF	DO 2 K=I,IFIX(S)
80900	CF	L=2
81000	CF	Y=XY(K)
81100	CF	IF(Y.LT.1000.)GO TO 3
81200	CF	L=3
81300	CF	Y=Y-1000.
81400	C   >1000 = INVIS. LINE
81500	CF3	M=Y
81600	CF	Y=(Y-M)*1000.
81700	CF	IF(Y.GT.100.)Y=100-Y
81800	C   Y NUMBERS .GT.100 ARE NEG.
81900	CF	B=Y*X+CENTR
82000	CF	IF(M.GT.60)M=100-M
82100	CF	A=M*RMINI+R3
82200	CF2	CALL LINES(A,B,L)
82300	CF	END
82400		
82500	CC	FUNCTION EEXP(X,Y)
82600	CC	EEXP=X**Y
82700	CC	END